home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
DDJMAG
/
DDJ8607.ZIP
/
SHAW.JUL
< prev
next >
Wrap
Text File
|
1986-07-31
|
13KB
|
379 lines
NOTE: SHOULD SCREENS BE RENUMBERED?????
Listing One
B:PAPERS.BLK
Screen 12*
0 \ FORTH-83 Standard type control structures GWS 86Mar31
1 \ note: !0 is 0 SWAP ! ADDR, is , (S is (
2
3 : >MARK HERE 2 ALLOT ; (S - a )( mark forward branch )
4 : >RESOLVE HERE SWAP ! ; (S a - )( patch forward branch )
5 : <MARK HERE ; (S - a )( destination for back branch )
6 : <RESOLVE ADDR, ; (S a - )( compile reference to a )
7
8 VARIABLE LEAVE-LIST
9 : >MARKLIST (S a - )( extend list at a, link in dictionary )
10 HERE SWAP DUP @ ADDR, ( link) ! ( new head) ;
11 : >RESOLVESLIST (S a - )( resolve all nodes in a to here )
12 DUP @ BEGIN DUP WHILE DUP @ SWAP >RESOLVE REPEAT
13 DROP !0 ; 1 2 +THRU
14
15
Screen 13
0 \ conditional compilers - if/else/then begin/while GWS 86Mar31
1
2 : IF (S - a / f - )( compile to branch if f is false )
3 COMPILE ?BRANCH >MARK ; IMMEDIATE
4 : ELSE (S a1 - a2 / - )( compile alternate to IF clause )
5 COMPILE BRANCH >MARK SWAP >RESOLVE ; IMMEDIATE
6 : THEN (S a - / - )( resolve latest forward reference )
7 >RESOLVE ; IMMEDIATE
8
9 : BEGIN <MARK ; IMMEDIATE (S - a / - )( mark loop start )
10 : WHILE [COMPILE] IF ; IMMEDIATE (S - a / f - )( loop exit )
11 : REPEAT (S a1 a2 - / - )( branch to beginning of loop )
12 COMPILE BRANCH SWAP <RESOLVE >RESOLVE ; IMMEDIATE
13 : UNTIL (S a - / f - )( branch to beginning of loop until true )
14 COMPILE ?BRANCH <RESOLVE ; IMMEDIATE
15
Screen 14
0 \ do loops GWS 86Mar31
1
2 : LEAVE (S - / - )( compile exit from structure )
3 COMPILE (LEAVE) LEAVE-LIST >MARKLIST ; IMMEDIATE
4
5 : DO (S - n a / n1 n2 - )( initiate counted loop )
6 COMPILE (DO) LEAVE-LIST @ LEAVE-LIST !0 <MARK ;
7 IMMEDIATE
8 : LOOP (S n a - / - )( compile increment loop end )
9 COMPILE (LOOP) <RESOLVE LEAVE-LIST >RESOLVESLIST
10 LEAVE-LIST ! ; IMMEDIATE
11 : +LOOP (S n a - / u - )( compile u incremented loop end )
12 COMPILE (+LOOP) <RESOLVE LEAVE-LIST >RESOLVESLIST
13 LEAVE-LIST ! ; IMMEDIATE
14
15
Listing Two
B:PAPERS.BLK
Screen 15*
0 \ typical BEGIN loop extensions GWS 86Mar31
1
2 : RESOLVES (S 0..a - )( resolve forward branches a until 0 )
3 BEGIN ?DUP WHILE >RESOLVE REPEAT ;
4
5 : BEGIN 0 <MARK ; IMMEDIATE (S 0 a - )( mark loop start )
6
7 : WHILE (S a1 - a2 a1 / f - )( conditional loop exit )
8 [COMPILE] IF SWAP ; IMMEDIATE
9
10 : REPEAT (S 0..an a - / - )( terminate repeating loop )
11 COMPILE BRANCH <RESOLVE RESOLVES ; IMMEDIATE
12 : UNTIL (S 0..an a - / f - )( terminate conditional loop )
13 COMPILE ?BRANCH <RESOLVE RESOLVES ; IMMEDIATE
14
15
Listing Three
B:PAPERS.BLK
Screen 3*
0 \ Proposed Standard Control Structures GWS 86Mar31
1 \ note: !0 is 0 SWAP ! ADDR, is , (S is (
2
3 : >MARK HERE 2 ALLOT ; (S - a )( mark forward branch )
4 : >RESOLVE HERE SWAP ! ; (S a - )( patch forward branch )
5 : <MARK HERE ; (S - a )( destination for back branch )
6 : <RESOLVE ADDR, ; (S a - )( compile reference to a )
7
8 : >MARKLIST (S a - )( extend list at a, link in dictionary )
9 HERE SWAP DUP @ ADDR, ( link) ! ( new head) ;
10 : >RESOLVELIST (S a - )( resolve top node in a to here )
11 DUP @ DUP @ ROT ! ( unlink top node) >RESOLVE ;
12 : >RESOLVESLIST (S a - )( resolve all nodes in a to here )
13 DUP @ BEGIN DUP WHILE DUP @ SWAP >RESOLVE REPEAT
14 DROP !0 ; 1 6 +THRU
15
Screen 4
0 \ compilation list initialization GWS 86Mar31
1 ORPHAN ( make headless words )
2 VARIABLE IF-LIST VARIABLE LEAVES-LIST VARIABLE LEAVE-LIST
3 VARIABLE LEAVE-CF
4 : INIT-LISTS (S - )( reset all list pointers )
5 IF-LIST !0 LEAVE-LIST !0 LEAVES-LIST !0 ;
6
7 : SAVE-LISTS (S - x x x x )( save current list pointers )
8 LEAVE-CF @ IF-LIST @ LEAVE-LIST @ LEAVES-LIST @
9 INIT-LISTS ;
10 : RESTORE-LISTS (S - x x x x )( restore current list pointers )
11 ( could check here for unresolved structures)
12 LEAVES-LIST ! LEAVE-LIST ! IF-LIST ! LEAVE-CF ! ;
13
14 ADOPT ( make headed words )
15
Screen 5
0 \ Conditional compilers - if/else/then & case GWS 86Mar31
1
2 : IF (S - / f - )( compile to branch if f is false )
3 COMPILE ?BRANCH IF-LIST >MARKLIST ; IMMEDIATE
4 : ELSE (S - / - )( compile alternate to IF clause )
5 COMPILE BRANCH IF-LIST >MARKLIST IF-LIST @ ( if branch)
6 >RESOLVELIST ; IMMEDIATE
7 : THEN (S - / - )( resolve latest forward reference )
8 IF-LIST >RESOLVELIST ; IMMEDIATE
9
10 : CASE (S - x x x x / ? - ? )( setup for case statement )
11 SAVE-LISTS ['] BRANCH LEAVE-CF ! ; IMMEDIATE
12 : ENDCASE (S - / x x x x - )( restore lists, resolve leaves )
13 LEAVES-LIST >RESOLVESLIST RESTORE-LISTS ; IMMEDIATE
14
15
B:PAPERS.BLK
Screen 6*
0 \ common loop end and exit GWS 86Mar31
1
2 ORPHAN ( make headless words )
3 : LOOPEND (S x x x x a1 a2 - )( resolve list a2 & branch )
4 ( a1, restore values x, transfer leaves-list to if-list )
5 SWAP <RESOLVE ( back branch) >RESOLVESLIST ( forward branch)
6 LEAVES-LIST @ ?DUP IF >R RESTORE-LISTS IF-LIST @ R@
7 BEGIN DUP @ WHILE @ REPEAT ( find leaves list end) !
8 ( link to if list) R> IF-LIST ! ELSE RESTORE-LISTS
9 THEN ;
10 ADOPT ( make headed words )
11 : OUTSIDE (S - / - )( allow LEAVES outside current loop level)
12 IF-LIST @ DUP @ IF-LIST ! ( unlink) LEAVES-LIST @ OVER !
13 COMPILE-UNNEST LEAVES-LIST ! ( relink) ; IMMEDIATE
14
15
Screen 7
0 \ do loops GWS 86Mar31
1
2 : LEAVE (S - / - )( compile exit from structure )
3 LEAVE-CF @ ADDR, LEAVE-LIST >MARKLIST ; IMMEDIATE
4 : LEAVES (S - / - )( compile exit to outside structure )
5 LEAVE-CF @ ADDR, LEAVES-LIST >MARKLIST [COMPILE] THEN ;
6 IMMEDIATE
7
8 : DO (S - x x x x a / u u - )( initiate counted loop )
9 SAVE-LISTS ['] (LEAVE) LEAVE-CF ! COMPILE (DO)
10 <MARK ; IMMEDIATE
11 : LOOP (S x x x x a - / - )( compile increment loop end )
12 COMPILE (LOOP) LEAVE-LIST LOOPEND ; IMMEDIATE
13 : +LOOP (S x x x x x a - / u - )( compile u+ loop end )
14 COMPILE (+LOOP) LEAVE-LIST LOOPEND ; IMMEDIATE
15
Screen 8
0 \ more loops GWS 86Mar31
1
2 : BEGIN (S - x x x x a / - )( mark start of a loop )
3 [COMPILE] CASE <MARK ; IMMEDIATE
4
5 : REPEAT (S x x x x a - / - )( terminate repeating loop )
6 COMPILE BRANCH IF-LIST LOOPEND
7 LEAVE-LIST >RESOLVESLIST ; IMMEDIATE
8 : UNTIL (S x x x x a - / - )( terminate repeating loop )
9 COMPILE ?BRANCH IF-LIST LOOPEND
10 LEAVE-LIST >RESOLVESLIST ; IMMEDIATE
11
12 : WHILE [COMPILE] IF ; IMMEDIATE (S - )( for compatibility)
13
14
15
Listing Four
B:PAPERS.BLK
Screen 9*
0 \ suggested extensions GWS 86Mar31
1
2 : ?LEAVE (S - / f - )( leave do loop if tf )
3 COMPILE (?LEAVE) LEAVE-LIST >MARKLIST ; IMMEDIATE
4 : ?LEAVES (S - / f - )( leave do loop if tf )
5 COMPILE (?LEAVE) LEAVES-LIST >MARKLIST ; IMMEDIATE
6
7 : THENS (S - / - )( resolve all outstanding IFs )
8 IF-LIST >RESOLVESLIST ; IMMEDIATE
9 : ELSES (S - / - )( resolve all outstanding IFs w/common ELSE )
10 [COMPILE] ELSE IF-LIST @ >RESOLVESLIST ; IMMEDIATE
11
12
13
14
15
Listing Five
Previously Proposed Solutions Proposed Solution
BEGIN ... same
WHILE ...
WHILE ...
...
REPEAT
BEGIN ... same
WHILE ...
WHILE ...
...
UNTIL
BEGIN ... BEGIN ...
WHILE ... WHILE
ANDWHILE ... WHILE
ANDWHILE ... WHILE
... ...
REPEAT REPEAT
BEGIN ... BEGIN ...
WHILE aa NOT IF ff LEAVES aa
WHILE bb NOT IF ee LEAVES bb
WHILE cc WHILE cc
... ...
REPEAT dd REPEAT dd
<WHILE ee
<WHILE ff
<END THEN THEN
BEGIN ... see below
IF ... LEAVE THEN
IF ... LEAVE THEN
...
REPEAT
BEGIN ... BEGIN ...
UNLESS ... FINISH IF ... LEAVES
UNLESS ... FINISH IF ... LEAVES
...
AGAIN REPEAT THEN THEN
DO ... DO ...
PERHAPS ... ESCAPE IF ... LEAVES
PERHAPS ... ESCAPE IF ... LEAVES
... ...
LOOP ... LOOP ...
ESCAPED ... THEN THEN ... (or ELSE ... THEN)
DO ... DO ...
IF ... LEAVE THEN aa IF ... LEAVES aa
LOOP--FALLTHRU: bb LOOP bb
THEN cc THEN cc
DO ... DO ...
WHEN ... NOT IF LEAVE THEN ...
LOOP LOOP
DO ... DO ...
NOTWHEN ... IF LEAVE THEN ...
LOOP LOOP
DO ... DO ...
IF LEAVE THEN ... IF LEAVES
EXITING LOOP LOOP
... ...
THEN THEN
none DO ...
DO ...
IF LEAVES
...
LOOP OUTSIDE
LOOP
...
THEN
none BEGIN ...
BEGIN ...
IF LEAVES
...
REPEAT OUTSIDE
REPEAT
...
THEN
<STEPS ... CASE
&IF ... IF ...
&IF ... IF ...
STEPS> THENS
ENDCASE
IF ... ELSE ... IF ... ELSE ...
THENIF ... ELSE IF ... ELSE ...
THENIF ... ELSE IF ... ELSE ...
... ...
THEN THENS or
CASE
IF ... LEAVES
IF ... LEAVES
...
ENDCASE
IF ... IF ...
ANDIF ... IF ...
ANDIF ... IF ...
... ...
( ELSE) ( ELSES)
THEN THENS ( THEN)
CASE ... CASE ...
OF ... ENDOF OVER = IF ... LEAVES
OF ... ENDOF OVER = IF ... LEAVES
... ...
ENDCASE DROP ENDCASE